perm filename SCUL.SAI[2,DBL] blob
sn#052978 filedate 1973-07-10 generic text, type T, neo UTF8
00100 BEGIN "MAIN"
00200 REQUIRE "HELIB[1,3]" LIBRARY;
00300 REAL ARRAY OBJECT[1:50,1:4];
00400 INTEGER ARRAY BUF[1:10000];
00500 INTEGER ARRAY STORAGE[1:25];
00600 INTEGER X,Y,NX,NY,PICNUM,NPTS,COUNT,BRCHAR,EXT,PPN,EOF,FLAG,VAL;
00700 REAL Z,Z2,VAL2,DX,XINIT,XFINAL,TOTX,YINIT,YFINAL,TOTY,DY;
00800 REAL LAMBDA,X2,Y2,SUM,A,B,C,A0,A2,A4,ARG2,ARG4;
00900 INTEGER NP,GREY,GREY2;
01000 STRING FILE;
01100 EXTERNAL INTEGER BITS,TVWORD,RSIDE,LSIDE,FLINE,LLINE,IWID;
01200 BOOLEAN FAIL;
01300 EXTERNAL PROCEDURE INTPNT;
01400 EXTERNAL PROCEDURE ADJUST;
01500 EXTERNAL PROCEDURE PUTPNT (INTEGER X,Y,VAL);
01600 EXTERNAL PROCEDURE PICWR(INTEGER CHAN,FILE,EXT,PPN;
01700 REFERENCE BOOLEAN FAIL; INTEGER ARRAY STORAGE);
01800 EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY BUF);
01900 INTEGER PROCEDURE GETPAR;
02000 BEGIN
02100
02400 OUTSTR("TYPE IN NPEGS...");
02500 NPTS←CVD(INCHWL);
02600 FOR X←1 STEP 1 UNTIL NPTS DO
02700 FOR Y←1 STEP 1 UNTIL 4 DO
02800 OBJECT[X,Y] ← REALIN(2);
02900 CLOSE(2);
03000 FOR X←NPTS+1 STEP 1 UNTIL 50 DO
03100 FOR Y←1 STEP 1 UNTIL 4 DO
03200 OBJECT[X,Y]←0;
03300 OUTSTR("TYPE XINIT... ");
03400 XINIT←CVD(INCHWL);
03500 OUTSTR("TYPE XFINAL.. ");
03600 XFINAL←CVD(INCHWL);
03700 OUTSTR("TYPE DELTA-X.. ");
03800 DX←CVD(INCHWL);
03900 TOTX←XFINAL-XINIT;
04000 NX←(TOTX+DX-1.0)/DX;
04100 OUTSTR("THEN TOTAL-X IS "&CVF(TOTX)&" AND NX (THE LINE LENGTH) IS "
04200 &CVS(NX)&'15 & '12);
04300 OUTSTR("TYPE YINIT... ");
04400 YINIT←CVD(INCHWL);
04500 OUTSTR("TYPE YFINAL.. ");
04600 YFINAL←CVD(INCHWL);
04700 OUTSTR("TYPE DELTA-Y... ");
04800 DY←CVD(INCHWL);
04900 TOTY←YFINAL-YINIT;
05000 NY←(TOTY+DY-1)/DY;
05100 OUTSTR("THEN TOTAL-Y IS " & CVF(TOTY) &
05200 " AND NY (THE VERT. HEIGHT) IS " & CVS(NY) & '15 & '12);
05300 OUTSTR("TYPE LAMBDA (ACTUALLY, LAMBDA SQUARED /16 PI-SQUARED)... ");
05400 LAMBDA ← CVD(INCHWL);
05500 OUTSTR("TYPE THE LOG (BASE 2) OF THE GREY SCALE... ");
05600 BITS ← CVD(INCHWL);
05700 GREY ← 2↑BITS;
05800 GREY2 ← GREY / 2;
05900 A0 ←1.000000;
06000 A2 ←-.5000;
06100 A4 ←0.0400;
06200 OUTSTR("THUS OUR GREY SCALE RANGES FROM 1 TO "&CVS(GREY)
06300 & '15 & '12);
06400 END;
06500
06600 INTEGER PROCEDURE INIT; BEGIN
06700 GETPAR;
06800 TVWORD ← GIOWD(BUF);
06900 RSIDE ← NX-1;
07000 LSIDE ← 0;
07100 FLINE ← 0;
07200 LLINE ← NY-1;
07300 IWID ← RSIDE - LSIDE + 1;
07400
07500
07600 FOR X ← 2 STEP 1 UNTIL 25 DO STORAGE[X]←0;
07700 STORAGE[1]←TVWORD+1;
07800
07900 ADJUST;
08000 INTPNT;
08100
08200 OUTSTR("TYPE IN THE PICTURE NUMBER....");
08300 PICNUM←CVD(INCHWL);
08400 FILE ← "H."&CVS(PICNUM)&"[2,DBL]";
08500 END;
08600
08700 REAL PROCEDURE COS2(REAL A,B,C);
08800 BEGIN
08900 ARG2 ← ((A*A) + (B*B) + (C*C)) / LAMBDA;
09000 VAL2← (ARG2↑0.5) MOD 3.1416;
09100 IF VAL2> 1.5708 THEN VAL2← 3.1416 - VAL2;
09200 ARG2 ← VAL2*VAL2;
09300 ARG4 ← ARG2 * ARG2;
09400 VAL2← A0 + (A2*ARG2) + (A*ARG4);
09500 VAL ← ((GREY2*VAL)/A0) + GREY2;
09600 RETURN(VAL);
09700 END;
09800
09900
10000 INTEGER PROCEDURE GETVAL(INTEGER X,Y);
10100 BEGIN
10200 SUM ← 0;
10300 X2 ← XINIT + (DX*X);
10400 Y2 ← YINIT + (DY*Y);
10500 FOR NP← 1 STEP 1 UNTIL NPTS DO
10600 SUM ← SUM + (OBJECT[NP,4]*COS2((X2-OBJECT[NP,1]),
10700 (Y2-OBJECT[NP,2]), OBJECT[NP,3]));
10800 VAL ← SUM;
10900 VAL ← (VAL MOD GREY2) + GREY2;
11000 RETURN(VAL);
11100 END;
11200
11300
11400 INIT;
11500 VAL←5;
11600 FOR X← LSIDE STEP 1 UNTIL RSIDE DO
11700 BEGIN
11800 OUTSTR(CVS(X)&" "&CVS(VAL)&" ");
11900 FOR Y ← FLINE STEP 1 UNTIL LLINE DO
12000 PUTPNT(X,Y,GETVAL(X,Y));
12100 END;
12200
12300 PICWR(1,CVFIL(FILE,EXT,PPN),EXT, PPN ,FAIL,STORAGE);
12400 OUTSTR("BUF HAS BEEN TRANSFERRED TO FILE " & FILE);
12500 OUTSTR(CVS(FAIL))
12600 END ;
12700